home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
SK210F
/
TESTLIST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-09
|
10KB
|
363 lines
{$I SHDEFINE.INC}
{$I SHUNITSW.INC}
unit TestList;
{
To test the ShList unit
Copyright 1991 Madison & Associates
All Rights Reserved
This program source file and the associated executable
file may be used and distributed only in accordance
with the provisions described on the title page of
the accompanying documentation file
SKYHAWK.DOC
}
interface
uses
TpCrt,
TpDos,
ShList;
procedure ListTest;
implementation
type
Str6 = string[6];
{$F+}
function Less(var DRec1, DRec2) : boolean;
begin
Less := (Str6(DRec1) <= Str6(DRec2));
end; {Less}
{$F-}
procedure ListTest;
const
NumLines = 7;
Dat : array[1..NumLines] of Str6 = (
'abcd-1',
'bcda-2',
'dcba-3',
'adcb-4',
'cdab-5',
'badc-6',
'dabc-7'
);
var
sL1, {Load by PUSHing}
sL2, {Load by APPENDing}
sL3 : slList; {Load by INSERTing the first element, PUSHing the second,
and INSERTing the remainder.}
dL0, {Load by INSERTing the first two elements and
INSERTPREVing the remainder.}
dL1, {Load by PUSHing}
dL2, {Load by APPENDing}
dL3, {Load by INSERTing the first element, PUSHing the second,
and INSERTing the remainder.}
dL4 : dlList; {Load by PutSorted}
OT : text;
S1 : Str6;
T1,
T2 : byte;
procedure slBombOut;
begin
WriteLn(OT, ' slBomb out');
halt;
end;
procedure dlBombOut;
begin
WriteLn(OT, ' dlBomb out');
end;
procedure AnyKey;
begin
if HandleIsConsole(1) then begin
Write('Any key to continue...');
if ReadKey = #0 then ;
WriteLn;
end;
end;
begin
if not OpenStdDev(OT, 1) then begin
WriteLn('Can''t open console device.');
Halt(1);
end;
if HandleIsConsole(1) then begin
WriteLn(OT,'This program produces extensive output, which you may wish');
WriteLn(OT,'to study in detail. For this reason, console output can be');
WriteLn(OT,'redirected to a file or to the printer. If you wish to' );
WriteLn(OT,'use this option, <Ctrl><Break> out at the following pause,');
WriteLn(OT,'and re-invoke the program with the desired redirection.' );
WriteLn(OT);
AnyKey;
end;
WriteLn(OT);
WriteLn(OT,'BEGINNING THE slList TEST SUITE');
T1 := 0;
WriteLn(OT,MemAvail);WriteLn(OT);
slListInit(sL1, SizeOf(S1));
slListInit(sL2, SizeOf(S1));
slListInit(sL3, SizeOf(S1));
for T1 := 1 to NumLines do begin
S1 := Dat[T1];
if not slPush(sL1, S1) then slBombOut;
WriteLn(OT,'sL1 ',S1:6, slCount(sL1):4, slSpaceUsed(sL1):5);
if not slAppend(sL2, S1) then slBombOut;
WriteLn(OT,'sL2 ',S1:6, slCount(sL2):4, slSpaceUsed(sL2):5);
if T1 = 2 then begin
if not slPush(sL3, S1) then slBombOut
end
else begin
if not slPut(sL3, S1) then slBombOut
end;
WriteLn(OT,'sL3 ',S1:6, slCount(sL3):4, slSpaceUsed(sL3):5);
WriteLn(OT,'Data string ',T1,' loaded.'); WriteLn(OT);
Flush(OT);
end; {for T1}
WriteLn(OT);
WriteLn(OT,'GetFirst check, using sL1');
S1 := '';
if not slGetFirst(sL1, S1) then slBombOut;
WriteLn(OT,S1:8);
WriteLn(OT);
WriteLn(OT,'GetLast check, using sL1');
S1 := '';
if not slGetLast(sL1, S1) then slBombOut;
WriteLn(OT,S1:8);
WriteLn(OT);
WriteLn(OT,'Tail Check on sL1, sL2, sL3.');
WriteLn(OT,'sL1, ',(sL1.Tail^.Next = nil),
' sL2, ',(sL2.Tail^.Next = nil),
' sL3, ',(sL3.Tail^.Next = nil));
AnyKey;
WriteLn(OT);
WriteLn(OT,'GetNext check, using sL1. [7..1]');
WriteLn(OT,slGetFirst(sL1, S1):6, S1:7);
for T2 := 2 to 2*sL1.Count do begin
WriteLn(OT,slGetNext(sL1, S1):6, S1:7);
end;
AnyKey;
WriteLn(OT);
WriteLn(OT,'GetNext check, using sL2. [1..7]');
WriteLn(OT,slGetFirst(sL2, S1):6, S1:7);
for T2 := 2 to 2*sL2.Count do begin
WriteLn(OT,slGetNext(sL2, S1):6, S1:7);
end;
AnyKey;
WriteLn(OT);
WriteLn(OT,'GetNext check, using sL3. [2..7, 1]');
WriteLn(OT,slGetFirst(sL3, S1):6, S1:7);
for T2 := 2 to 2*sL3.Count do begin
WriteLn(OT,slGetNext(sL3, S1):6, S1:7);
end;
AnyKey;
WriteLn(OT);
WriteLn(OT,'Tail Check on sL1, sL2, sL3.');
WriteLn(OT,'sL1, ',(sL1.Tail^.Next = nil),
' sL2, ',(sL2.Tail^.Next = nil),
' sL3, ',(sL3.Tail^.Next = nil));
AnyKey;
WriteLn(OT);
WriteLn(OT,'Pop test, using sL1. [7..1]');
while slPop(sL1, S1) do
WriteLn(OT,S1);
WriteLn(OT,'sL1 ', slCount(sL1):3, slSpaceUsed(sL1):3);
AnyKey;
WriteLn(OT);
WriteLn(OT,'Free test, using sL2, sL3.');
slFree(sL2); slFree(sL3);
WriteLn(OT,'sL2 ', slCount(sL2):3, slSpaceUsed(sL2):3);
WriteLn(OT,'sL3 ', slCount(sL3):3, slSpaceUsed(sL3):3);
WriteLn(OT,MemAvail);
slFree(sL1);
AnyKey;
WriteLn(OT);
WriteLn(OT,'BEGINNING THE dlList TEST SUITE');
WriteLn(OT,MemAvail); WriteLn(OT);
dlListInit(dL0, SizeOf(S1));
dlListInit(dL1, SizeOf(S1));
dlListInit(dL2, SizeOf(S1));
dlListInit(dL3, SizeOf(S1));
dlListInit(dL4, SizeOf(S1));
for T1 := 1 to NumLines do begin
S1 := Dat[T1];
if T1 < 3 then begin
if not dlPut(dL0, S1) then dlBombOut;
end
else begin
if not dlPutPrev(dL0, S1) then dlBombOut;
end;
WriteLn(OT,'dL0 ',S1:6, dlCount(dL0):4, dlSpaceUsed(dL0):5);
if not dlPush(dL1, S1) then dlBombOut;
WriteLn(OT,'dL1 ',S1:6, dlCount(dL1):4, dlSpaceUsed(dL1):5);
if not dlAppend(dL2, S1) then dlBombOut;
WriteLn(OT,'dL2 ',S1:6, dlCount(dL2):4, dlSpaceUsed(dL2):5);
if T1 = 2 then begin
if not dlPush(dL3, S1) then dlBombOut
end
else begin
if not dlPut(dL3, S1) then dlBombOut
end;
WriteLn(OT,'dL3 ',S1:6, dlCount(dL3):4, dlSpaceUsed(dL3):5);
if not dlPutSorted(dL4, S1, Less) then dlBombOut;
WriteLn(OT,'dL4 ',S1:6, dlCount(dL4):4, dlSpaceUsed(dL4):5);
WriteLn(OT,'Data string ',T1,' loaded.'); WriteLn(OT);
Flush(OT);
end; {for T1}
WriteLn(OT);
WriteLn(OT,'GetFirst check, using dL1.');
S1 := '';
if not dlGetFirst(dL1, S1) then dlBombOut;
WriteLn(OT,S1:8);
WriteLn(OT);
WriteLn(OT,'GetLast check, using dL1.');
S1 := '';
if not dlGetLast(dL1, S1) then dlBombOut;
WriteLn(OT,S1:8);
WriteLn(OT);
WriteLn(OT,'Tail Check on dL1, dL2, dL3.');
WriteLn(OT,'dL1, ',(dL1.Tail^.Next = nil),
' dL2, ',(dL2.Tail^.Next = nil),
' dL3, ',(dL3.Tail^.Next = nil));
AnyKey;
WriteLn(OT);
WriteLn(OT,'GetNext check, using dL0. [1, 7..2]');
WriteLn(OT,dlGetFirst(dL0, S1):6, S1:7);
for T2 := 2 to 2*dL0.Count do begin
WriteLn(OT,dlGetNext(dL0, S1):6, S1:7);
end;
AnyKey;
WriteLn(OT);
WriteLn(OT,'GetNext check, using dL1. [7..1]');
WriteLn(OT,dlGetFirst(dL1, S1):6, S1:7);
for T2 := 2 to 2*dL1.Count do begin
WriteLn(OT,dlGetNext(dL1, S1):6, S1:7);
end;
AnyKey;
WriteLn(OT);
WriteLn(OT,'GetNext check, using dL1. [7..1]');
WriteLn(OT,dlGetFirst(dL1, S1):6, S1:7);
for T2 := 2 to 2*dL1.Count do begin
WriteLn(OT,dlGetNext(dL1, S1):6, S1:7);
end;
AnyKey;
WriteLn(OT);
WriteLn(OT,'GetNext check, using dL2. [1..7]');
WriteLn(OT,dlGetFirst(dL2, S1):6, S1:7);
for T2 := 2 to 2*dL2.Count do begin
WriteLn(OT,dlGetNext(dL2, S1):6, S1:7);
end;
AnyKey;
WriteLn(OT);
WriteLn(OT,'GetNext check, using dL3. [2..7, 1]');
WriteLn(OT,dlGetFirst(dL3, S1):6, S1:7);
for T2 := 2 to 2*dL3.Count do begin
WriteLn(OT,dlGetNext(dL3, S1):6, S1:7);
end;
AnyKey;
WriteLn(OT);
WriteLn(OT,'GetNext check, using dL4. [1, 4, 6, 2, 5, 7, 3]');
WriteLn(OT,dlGetFirst(dL4, S1):6, S1:7);
for T2 := 2 to 2*dL4.Count do begin
WriteLn(OT,dlGetNext(dL4, S1):6, S1:7);
end;
AnyKey;
WriteLn(OT);
WriteLn(OT,'Tail Check on dL0, dL1, dL2, dL3.');
WriteLn(OT,'dL0, ',(dL0.Tail^.Next = nil),
' dL1, ',(dL1.Tail^.Next = nil),
' dL2, ',(dL2.Tail^.Next = nil),
' dL3, ',(dL3.Tail^.Next = nil));
AnyKey;
WriteLn(OT);
WriteLn(OT,'Head Check on dL0, dL1, dL2, dL3.');
WriteLn(OT,'dL0, ',(dL0.Head^.Prev = nil),
' dL1, ',(dL1.Head^.Prev = nil),
' dL2, ',(dL2.Head^.Prev = nil),
' dL3, ',(dL3.Head^.Prev = nil));
AnyKey;
WriteLn(OT);
WriteLn(OT,'Read reverse using dL0, dL1, dL2, dL3.');
WriteLn(OT,' Read from tail to head, ''Bomb Out'', Read from tail.');
if dlGetLast(dL0, S1) then Write(OT, S1:7) else dlBombOut;
if dlGetLast(dL1, S1) then Write(OT, S1:7) else dlBombOut;
if dlGetLast(dL2, S1) then Write(OT, S1:7) else dlBombOut;
if dlGetLast(dL3, S1) then WriteLn(OT,S1:7) else dlBombOut;
for T2 := 2 to 2*dL0.Count do begin
if dlGetPrev(dL0, S1) then Write(OT, S1:7) else dlBombOut;
if dlGetPrev(dL1, S1) then Write(OT, S1:7) else dlBombOut;
if dlGetPrev(dL2, S1) then Write(OT, S1:7) else dlBombOut;
if dlGetPrev(dL3, S1) then WriteLn(OT,S1:7) else dlBombOut;
end;
AnyKey;
WriteLn(OT);
WriteLn(OT,'Pop test, using dL1.');
while dlPop(dL1, S1) do
WriteLn(OT,S1);
WriteLn(OT,'dL1 ', dlCount(dL1):3, dlSpaceUsed(dL1):3);
AnyKey;
WriteLn(OT);
WriteLn(OT,'Pop test, using dL4.');
while dlPop(dL4, S1) do
WriteLn(OT,S1);
WriteLn(OT,'dL4 ', dlCount(dL4):3, dlSpaceUsed(dL4):3);
AnyKey;
WriteLn(OT);
WriteLn(OT,'Free test, using dL0, dL2, dL3, dL4.');
dlFree(dL0); dlFree(dL2); dlFree(dL3); dlFree(dL3);
WriteLn(OT,'dL0 ', dlCount(dL0):3, dlSpaceUsed(dL0):3);
WriteLn(OT,'dL2 ', dlCount(dL2):3, dlSpaceUsed(dL2):3);
WriteLn(OT,'dL3 ', dlCount(dL3):3, dlSpaceUsed(dL3):3);
WriteLn(OT,'dL4 ', dlCount(dL4):3, dlSpaceUsed(dL4):3);
WriteLn(OT,MemAvail);
Close(OT);
end; {ListTest}
end.